home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
MUSIUSIC
/
PLAYERS.LZH
/
VOC_IO.PKG
< prev
next >
Wrap
Text File
|
1991-01-07
|
12KB
|
364 lines
package body VOC_IO is
use voc_data;
pragma Optimize(Time);
type One_Byte_Naturals is range 0 .. 255;
for One_Byte_Naturals'Size use 8;
type Two_Byte_Naturals is range 0 .. 65535;
for Two_Byte_Naturals'Size use 16;
type file_type_descriptions is array(0 .. 16#13#) of one_byte_naturals;
type Headers is record
File_Type_Description : file_type_descriptions;
Offset_Of_Data_Block : dos_io.byte_counts;
version_minor : one_byte_naturals;
version_major : one_byte_naturals;
id_code_minor : one_byte_naturals;
id_code_major : one_byte_naturals;
end record;
Headers_Bytes:constant Dos_IO.Byte_Counts
:=Dos_IO.Byte_Counts(Headers'Size/8);
type block_headers is record
block_type : block_types;
blklen : blklens;
end record;
block_header_length:constant:=4;
function "-" (Left,
Right : in Dos_IO.Byte_Counts)
return Dos_IO.Byte_Counts renames Dos_IO."-";
function "=" (Left,
Right : in Dos_IO.Byte_Counts)
return Boolean renames Dos_IO."=";
function ">" (Left,
Right : in Dos_IO.Byte_Counts)
return Boolean renames Dos_IO.">";
procedure Open(Name : in String;
Handle : in out Handles) is
Header : Headers;
begin
begin
Dos_IO.Open(Name, Handle.File_Handle);
exception
when dos_io.name_error => raise name_error;
end;
handle.is_input:=true;
if Dos_IO.Read(Handle.File_Handle, Header'Address, Headers_Bytes)
/= Headers_Bytes then
Dos_IO.Close(Handle.File_Handle);
raise Data_Error;
end if;
if 16#12#-header.version_major /= header.id_code_major then
raise data_error;
end if;
if 16#33#-header.version_minor /= header.id_code_minor then
raise data_error;
end if;
if header.offset_of_data_block /= headers_bytes then
Dos_IO.Skip(Handle.File_Handle,
headers_bytes-header.offset_of_data_block);
end if;
handle.voice_info:=(voice_to_continue=>false);
end Open;
procedure Read(Handle : in out Handles;
block : out VOC_data.blocks) is
this_type : VOC_data.block_types;
block_length : VOC_data.block_lengths;
sample_rate : VOC_data.sample_rates;
null_byte : one_byte_naturals;
blklen : blklens;
function this_length return blklens is
blklen:blklens;
begin
blklen:=0; -- zero out 4th allocated byte, assume Intel format
if dos_io.read(handle.file_handle,blklen'address,3) /= 3 then
raise Status_Error;
end if;
return blklen;
end this_length;
function this_rate return voc_data.sample_rates is
type srs is range 0 .. 255;
for srs'size use 8;
sr:srs;
begin
if dos_io.read(handle.file_handle,sr'address,1) /= 1 then
raise Status_Error;
end if;
return voc_data.sample_rates(1000000/(256-long_integer(sr)));
end this_rate;
function this_pack return voc_data.pack_types is
type packs is range 0 .. 255;
for packs'size use 8;
pack:packs;
begin
if dos_io.read(handle.file_handle,pack'address,1) /= 1 then
raise Status_Error;
end if;
return voc_data.pack_types'val(pack);
end this_pack;
function this_2 return two_byte_naturals is
n:two_byte_naturals;
begin
if dos_io.read(handle.file_handle,n'address,2) /= 2 then
raise Status_Error;
end if;
return n;
end this_2;
procedure get_sound is
chunk_length:dos_io.byte_counts;
begin
if handle.voice_info.remaining_length > blklens(max_sound_length) then
chunk_length:=dos_io.byte_counts(max_sound_length);
else
chunk_length:=dos_io.byte_counts(handle.voice_info.remaining_length);
end if;
block:=(voice_data,integer(chunk_length),
handle.voice_info.sample_rate,
handle.voice_info.packing,
data=>(others=>0));
if dos_io.read(handle.file_handle,block.data(1)'address,
chunk_length) /= chunk_length then
raise data_error;
end if;
handle.voice_info.remaining_length
:=handle.voice_info.remaining_length-blklens(chunk_length);
end get_sound;
begin
if not handle.is_input then
raise status_error;
end if;
if handle.terminated then
block:=(terminator,0);
return;
end if;
if not Dos_IO.Is_Open(Handle.File_Handle) then
raise Status_Error;
end if;
if handle.voice_info.voice_to_continue and then
handle.voice_info.remaining_length > 0 then
get_sound;
return;
end if;
if dos_IO.read(handle.file_handle,this_type'address,1) /= 1 then
raise data_error;
end if;
case this_type is
when terminator =>
handle.terminated:=true;
block:=(terminator,0);
when voice_data =>
blklen:=this_length-2;
sample_rate:=this_rate;
handle.voice_info:=(voice_to_continue=>true,
sample_rate=>sample_rate,
packing=>this_pack,
remaining_length=>blklen);
get_sound;
when voice_continuation =>
if not handle.voice_info.voice_to_continue then
raise data_error;
end if;
handle.voice_info.remaining_length:=this_length;
get_sound;
when silence =>
if this_length /= 3 then
raise data_error;
end if;
block:=(silence,0,(duration(this_2)+1.0)/this_rate);
when marker =>
if this_length /= 2 then
raise data_error;
end if;
block:=(block_type=>marker,block_length=>0,mark=>markers(this_2));
when text =>
block_length:=block_lengths(this_length-1);
block:=(text,block_length,text_string=>(others=>' '));
if dos_io.read(handle.file_handle,block.text_string(1)'address,
dos_io.byte_counts(block_length))
/= dos_io.byte_counts(block_length) then
raise data_error;
end if;
if dos_io.read(handle.file_handle,null_byte'address,1) /= 1
or else null_byte /= 0 then
raise data_error;
end if;
when start_repeat =>
if this_length /= 2 then
raise data_error;
end if;
block:=(start_repeat,0,voc_data.repeat_counts(this_2));
when end_repeat =>
if this_length /= 0 then
raise data_error;
end if;
block:=(end_repeat,0);
end case;
end Read;
procedure Create(Name : in String;
Handle : in out Handles) is
header:headers:=
(File_Type_Description => (others => 16#1A#),
Offset_Of_Data_Block => headers_bytes,
version_minor => 10,
version_major => 1,
id_code_minor => 16#29#,
id_code_major => 16#11#
);
magic_name:constant string:="Creative Voice File";
begin
for i in magic_name'range loop
header.file_type_description(i-magic_name'first
+header.file_type_description'first)
:=character'pos(magic_name(i));
end loop;
begin
dos_io.create(name,handle.file_handle);
exception
when dos_io.name_error => raise name_error;
end;
handle.is_input:=false;
if Dos_IO.write(Handle.File_Handle, Header'Address, Headers_Bytes)
/= Headers_Bytes then
Dos_IO.Close(Handle.File_Handle);
raise disk_full;
end if;
end create;
procedure write_block_header(Handle : in out Handles;
block_type : in block_types;
blklen : in blklens) is
block_header:block_headers:=(block_type,blklen);
begin
if Dos_IO.write(Handle.File_Handle,block_header'Address,
block_header_length) /= block_header_length then
raise disk_full;
end if;
end write_block_header;
procedure Write_sound(Handle : in out Handles;
block : in VOC_data.blocks) is
type infos is record
sr : one_byte_naturals;
pack : pack_types;
end record;
info:infos:=(one_byte_naturals(256-1000000/long_integer(block.sample_rate)),
block.packing);
sound_length:constant dos_io.byte_counts
:=dos_io.byte_counts(block.block_length);
begin
if handle.is_input then
raise status_error;
end if;
if block.block_type /= voice_data then
raise data_error;
end if;
write_block_header(Handle,voice_data,blklens(block.block_length+2));
if dos_io.write(Handle.File_Handle,info'address,2) /= 2 then
raise disk_full;
end if;
if dos_io.write(Handle.File_Handle,block.data(1)'address,sound_length)
/= sound_length then
raise disk_full;
end if;
end write_sound;
procedure Write_silence(Handle : in out Handles;
interval : in duration;
sample_rate : in VOC_data.sample_rates:=8000) is
type infos is record
period : two_byte_naturals;
sr : one_byte_naturals;
end record;
period:two_byte_naturals:=two_byte_naturals(sample_rate*interval);
info:infos;
info_length:constant dos_io.byte_counts:=dos_io.byte_counts(info'size/8);
begin
if handle.is_input then
raise status_error;
end if;
if period < 1 then return;end if;
info:=(period-1,
one_byte_naturals(256-1000000/long_integer(sample_rate)));
write_block_header(handle,silence,3);
if Dos_IO.write(Handle.File_Handle,info'Address,info_length)
/= info_length then
raise disk_full;
end if;
end write_silence;
procedure Write_marker(Handle : in out Handles;
mark : in VOC_data.markers) is
m_length:constant dos_io.byte_counts:=dos_io.byte_counts(markers'size/8);
begin
if handle.is_input then
raise status_error;
end if;
write_block_header(handle,marker,2);
if Dos_IO.write(Handle.File_Handle,mark'Address,m_length) /= m_length then
raise disk_full;
end if;
end write_marker;
procedure Write_text(Handle : in out Handles;
text : in string) is
text_length:constant dos_io.byte_counts:=dos_io.byte_counts(text'length);
null_byte:one_byte_naturals:=0;
begin
if handle.is_input then
raise status_error;
end if;
write_block_header(handle,voc_data.text,text'length+1);
if Dos_IO.write(Handle.File_Handle,text(text'first)'Address,text_length)
/= text_length then
raise disk_full;
end if;
if Dos_IO.write(Handle.File_Handle,null_byte'Address,1) /= 1 then
raise disk_full;
end if;
end write_text;
procedure Write_repeat(Handle : in out Handles;
count : in VOC_data.repeat_counts) is
r_length:constant dos_io.byte_counts:=dos_io.byte_counts(repeat_counts'size/8);
begin
if handle.is_input then
raise status_error;
end if;
write_block_header(handle,start_repeat,2);
if Dos_IO.write(Handle.File_Handle,count'Address,r_length) /= r_length then
raise disk_full;
end if;
end write_repeat;
procedure Write_end_repeat(Handle : in out Handles) is
begin
if handle.is_input then
raise status_error;
end if;
write_block_header(handle,end_repeat,0);
end write_end_repeat;
procedure Close(Handle : in out Handles) is
fini:block_types:=terminator;
fini_length:constant dos_io.byte_counts:=dos_io.byte_counts(fini'size/8);
begin
if not handle.is_input then
if Dos_IO.write(Handle.File_Handle,fini'Address,fini_length)
/= fini_length then
raise disk_full;
end if;
end if;
Dos_IO.Close(Handle.File_Handle);
end Close;
end VOC_IO;